home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1997
/
HAM Radio 1997.iso
/
vcls
/
inmemory
/
temptbl.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-08
|
6KB
|
189 lines
{
This is an TempTable example. Free for anyone to use, modify and do
whatever else you wish.
TempTables are supposedly also in-memory tables and provide all of the
functionality of regular tables. The problem with these is that in DB.PAS
there is a line in TDataSet.InternalOpen that sets CanModify to False if
the table is temporary. Why - I don't know, but if you have the VCL source
(which I highly recommend if you're serious about Delphi programming) then
you can just comment that part out. Otherwise - this unit is useless to you :(
Just like all things free it comes with no guarantees. I cannot be responsible
for any damage this code may cause.
Thanks to Steve Garland <72700.2407@compuserve.com> for his help. He
created his own variation of an in-memory table component and I used it
to get started.
If you have comments - please contact me at INTERNET:grisha@mira.com
Happy hacking!
Gregory Trubetskoy
}
unit Temptbl;
interface
uses DBTables, WinTypes, WinProcs, DBITypes, DBIProcs, DB, SysUtils;
type TTempTable = class(TTable)
private
hCursor: hDBICur;
procedure EncodeFieldDesc(var FieldDesc: FLDDesc;
const Name: string; DataType: TFieldType; Size: Word);
function CreateHandle: HDBICur; override;
procedure EncodeIndexDesc(var IndexDesc: IDXDesc;
const Name, Fields: string; Options: TIndexOptions);
public
procedure CreateTable;
end;
implementation
function TTempTable.CreateHandle;
begin
Result := hCursor;
end;
procedure TTempTable.EncodeIndexDesc(var IndexDesc: IDXDesc;
const Name, Fields: string; Options: TIndexOptions);
var
Pos: Integer;
begin
FillChar(IndexDesc, SizeOf(IndexDesc), 0);
with IndexDesc do
begin
{ if IsDBaseTable then
AnsiToNative(DBLocale, Name, szTagName, SizeOf(szTagName) - 1)
else
AnsiToNative(DBLocale, Name, szName, SizeOf(szName) - 1); }
bPrimary := ixPrimary in Options;
bUnique := ixUnique in Options;
bDescending := ixDescending in Options;
bMaintained := True;
bCaseInsensitive := ixCaseInsensitive in Options;
if ixExpression in Options then
begin
bExpIdx := True;
AnsiToNative(DBLocale, Fields, szKeyExp, SizeOf(szKeyExp) - 1);
end else
begin
Pos := 1;
while (Pos <= Length(Fields)) and (iFldsInKey < 16) do
begin
aiKeyFld[iFldsInKey] :=
FieldDefs.Find(ExtractFieldName(Fields, Pos)).FieldNo;
Inc(iFldsInKey);
end;
end;
end;
end;
procedure TTempTable.EncodeFieldDesc(var FieldDesc: FLDDesc;
const Name: string; DataType: TFieldType; Size: Word);
const
TypeMap: array[TFieldType] of Byte = (
fldUNKNOWN, fldZSTRING, fldINT16, fldINT32, fldUINT16, fldBOOL,
fldFLOAT, fldFLOAT, fldBCD, fldDATE, fldTIME, fldTIMESTAMP, fldBYTES,
fldVARBYTES, fldBLOB, fldBLOB, fldBLOB);
begin
with FieldDesc do
begin
AnsiToNative(Locale, Name, szName, SizeOf(szName) - 1);
iFldType := TypeMap[DataType];
case DataType of
ftString, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic:
iUnits1 := Size;
ftBCD:
begin
iUnits1 := 32;
iUnits2 := Size;
end;
end;
case DataType of
ftCurrency:
iSubType := fldstMONEY;
ftBlob:
iSubType := fldstBINARY;
ftMemo:
iSubType := fldstMEMO;
ftGraphic:
iSubType := fldstGRAPHIC;
end;
end;
end;
procedure TTempTable.CreateTable;
var
I, J: Integer;
FieldDescs: PFLDDesc;
ValCheckPtr: PVCHKDesc;
DriverTypeName: DBINAME;
TableDesc: CRTblDesc;
begin
CheckInactive;
if FieldDefs.Count = 0 then
for I := 0 to FieldCount - 1 do
with Fields[I] do
if not Calculated then
FieldDefs.Add(FieldName, DataType, Size, Required);
FieldDescs := nil;
FillChar(TableDesc, SizeOf(TableDesc), 0);
with TableDesc do
begin
SetDBFlag(dbfTable, True);
try
AnsiToNative(Locale, TableName, szTblName, SizeOf(szTblName) - 1);
{if GetTableTypeName <> nil then
StrCopy(szTblType, GetTableTypeName);}
iFldCount := FieldDefs.Count;
FieldDescs := AllocMem(iFldCount * SizeOf(FLDDesc));
for I := 0 to FieldDefs.Count - 1 do
with FieldDefs[I] do
begin
EncodeFieldDesc(PFieldDescList(FieldDescs)^[I], Name,
DataType, Size);
if Required then Inc(iValChkCount);
end;
pFldDesc := AllocMem(iFldCount * SizeOf(FLDDesc));
Check(DbiTranslateRecordStructure(nil, iFldCount, FieldDescs,
nil, nil, pFLDDesc));
iIdxCount := IndexDefs.Count;
pIdxDesc := AllocMem(iIdxCount * SizeOf(IDXDesc));
for I := 0 to IndexDefs.Count - 1 do
with IndexDefs[I] do
EncodeIndexDesc(PIndexDescList(pIdxDesc)^[I], Name, Fields,
Options);
if iValChkCount <> 0 then
begin
pVChkDesc := AllocMem(iValChkCount * SizeOf(VCHKDesc));
ValCheckPtr := pVChkDesc;
for I := 0 to FieldDefs.Count - 1 do
if FieldDefs[I].Required then
begin
ValCheckPtr^.iFldNum := I + 1;
ValCheckPtr^.bRequired := True;
Inc(ValCheckPtr);
end;
end;
Check(DbiCreateTempTable(DBHandle, TableDesc, hCursor));
Check(DbiSetProp(hDBIObj(hCursor), curXLTMODE, LongInt(xltFIELD)));
finally
if pVChkDesc <> nil then FreeMem(pVChkDesc, iValChkCount * SizeOf(VCHKDesc));
if pIdxDesc <> nil then FreeMem(pIdxDesc, iIdxCount * SizeOf(IDXDesc));
if pFldDesc <> nil then FreeMem(pFldDesc, iFldCount * SizeOf(FLDDesc));
if FieldDescs <> nil then FreeMem(FieldDescs, iFldCount * SizeOf(FLDDesc));
SetDBFlag(dbfTable, False);
end;
end;
end;
end.